home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-05-03 | 2.2 KB | 70 lines | [TEXT/CCL2] |
-
- (in-package "VOICE-TOOLKIT")
-
- (export '(voice-window window-select window-show
- window-hide add-subviews remove-subviews window-event modal-dialog
- voice-return-from-modal-dialog window-close))
-
- (defclass voice-window (window)
- ((modal :accessor modal :initform nil)))
-
- (defmethod identify ((vw voice-window))
- (voice-mapvect (view-subviews vw)
- #'identify
- 0
- (length (view-subviews vw))))
-
- (defmethod window-select ((vw voice-window))
- (new-voice-window vw)
- (call-next-method vw))
-
- (defmethod window-show ((vw voice-window))
- (new-voice-window vw)
- (call-next-method vw))
-
- (defmethod window-hide ((vw voice-window))
- (remove-voice-window vw)
- (call-next-method vw))
-
- (defmethod add-subviews ((vw voice-window) &rest subviews)
- (apply #'call-next-method (cons vw subviews))
- (new-voice-window vw))
-
- (defmethod remove-subviews ((vw voice-window) &rest subviews)
- (apply #'call-next-method (cons vw subviews))
- (new-voice-window vw))
-
- (defmethod window-event ((vw voice-window))
- (call-next-method vw))
-
- (defmethod voice-handler ((vw voice-window) theAppleEvent reply handlerRefcon)
- (declare (ignore handlerRefcon) (ignore reply))
- (or *voice-system* (progn (setf *voice-system* t) (show-flag)))
- (hear (string-upcase (ccl::ae-get-parameter-char theAppleEvent #$keyDirectObject t))))
-
- (install-appleevent-handler :|aevt| :|hear| #'voice-handler)
-
- (defparameter *exit-modal-dialog* nil)
-
- (defparameter *modal-dialog-return-value* nil)
-
- (defun test-for-exit ()
- (if *exit-modal-dialog*
- (return-from-modal-dialog *modal-dialog-return-value*)))
-
- (defmethod modal-dialog ((vw voice-window) &optional close-on-exit eventhook)
- (setf *exit-modal-dialog* nil)
- (setf (modal vw) t)
- (setf *modal-dialog-return-value* nil)
- (call-next-method vw close-on-exit (if (listp eventhook)
- (cons #'test-for-exit eventhook)
- (list #'test-for-exit eventhook))))
-
- (defun voice-return-from-modal-dialog (arg)
- (setf *modal-dialog-return-value* arg)
- (setf *exit-modal-dialog* t))
-
- (defmethod window-close ((vw voice-window))
- (if (modal vw)
- (voice-return-from-modal-dialog nil)
- (call-next-method vw)))